home *** CD-ROM | disk | FTP | other *** search
/ Ham Radio 2000 / Ham Radio 2000.iso / ham2000 / misc / dspice0s / setprn.c < prev    next >
C/C++ Source or Header  |  1992-11-21  |  9KB  |  298 lines
  1. /* setprn.f -- translated by f2c (version of 3 February 1990  3:36:42).
  2.    You must link the resulting object file with the libraries:
  3.     -lF77 -lI77 -lm -lc   (in that order)
  4. */
  5.  
  6. #include "f2c.h"
  7.  
  8. /* Common Block Declarations */
  9.  
  10. struct {
  11.     integer ielmnt, isbckt, nsbckt, iunsat, nunsat, itemps, numtem, isens, 
  12.         nsens, ifour, nfour, ifield, icode, idelim, icolum, insize, 
  13.         junode, lsbkpt, numbkp, iorder, jmnode, iur, iuc, ilc, ilr, 
  14.         numoff, isr, nmoffc, iseq, iseq1, neqn, nodevs, ndiag, iswap, 
  15.         iequa, macins, lvnim1, lx0, lvn, lynl, lyu, lyl, lx1, lx2, lx3, 
  16.         lx4, lx5, lx6, lx7, ld0, ld1, ltd, imynl, imvn, lcvn, nsnod, 
  17.         nsmat, nsval, icnod, icmat, icval, loutpt, lpol, lzer, irswpf, 
  18.         irswpr, icswpf, icswpr, irpt, jcpt, irowno, jcolno, nttbr, nttar, 
  19.         lvntmp;
  20. } tabinf_;
  21.  
  22. #define tabinf_1 tabinf_
  23.  
  24. struct {
  25.     doublereal omega, time, delta, delold[7], ag[7], vt, xni, egfet, xmu, 
  26.         sfactr;
  27.     integer mode, modedc, icalc, initf, method, iord, maxord, noncon, iterno, 
  28.         itemno, nosolv, modac, ipiv, ivmflg, ipostp, iscrch, iofile;
  29. } status_;
  30.  
  31. #define status_1 status_
  32.  
  33. struct {
  34.     doublereal atime, aprog[3], adate, atitle[10], defl, defw, defad, defas, 
  35.         rstats[50];
  36.     integer iwidth, lwidth, nopage;
  37. } miscel_;
  38.  
  39. #define miscel_1 miscel_
  40.  
  41. struct {
  42.     doublereal tcstar[2], tcstop[2], tcincr[2];
  43.     integer icvflg, itcelm[2], kssop, kinel, kidin, kovar, kidout;
  44. } dc_;
  45.  
  46. #define dc_1 dc_
  47.  
  48. struct {
  49.     doublereal fstart, fstop, fincr, skw2, refprl, spw2;
  50.     integer jacflg, idfreq, inoise, nosprt, nosout, nosin, idist, idprt;
  51. } ac_;
  52.  
  53. #define ac_1 ac_
  54.  
  55. struct {
  56.     doublereal tstep, tstop, tstart, delmax, tdmax, forfre;
  57.     integer jtrflg;
  58. } tran_;
  59.  
  60. #define tran_1 tran_
  61.  
  62. struct {
  63.     doublereal xincr, string[15], xstart, yvar[8];
  64.     integer itab[8], itype[8], ilogy[8], npoint, numout, kntr, numdgt;
  65. } outinf_;
  66.  
  67. #define outinf_1 outinf_
  68.  
  69. struct {
  70.     doublereal value[200000];
  71. } blank_;
  72.  
  73. #define blank_1 blank_
  74.  
  75. /* Table of constant values */
  76.  
  77. static integer c__1 = 1;
  78. static integer c__7 = 7;
  79.  
  80. /*<       subroutine setprn(loc) >*/
  81. /* Subroutine */ int setprn_(loc)
  82. integer *loc;
  83. {
  84.     /* Initialized data */
  85.  
  86.     static struct {
  87.     char e_1[8];
  88.     doublereal e_2;
  89.     } equiv_17 = { {' ', ' ', ' ', ' ', ' ', ' ', ' ', ' '}, 0. };
  90.  
  91. #define ablnk (*(doublereal *)&equiv_17)
  92.  
  93.     static struct {
  94.     char e_1[8];
  95.     doublereal e_2;
  96.     } equiv_18 = { {' ', ' ', 't', 'i', 'm', 'e', ' ', ' '}, 0. };
  97.  
  98. #define atimex (*(doublereal *)&equiv_18)
  99.  
  100.     static struct {
  101.     char e_1[8];
  102.     doublereal e_2;
  103.     } equiv_19 = { {' ', ' ', 'f', 'r', 'e', 'q', ' ', ' '}, 0. };
  104.  
  105. #define afreq (*(doublereal *)&equiv_19)
  106.  
  107.  
  108.     /* Format strings */
  109.     static char fmt_91[] = "(/3x,a8,5x,14a8,a4)";
  110.     static char fmt_101[] = "(\002x\002/\002 \002)";
  111.  
  112.     /* System generated locals */
  113.     integer i_1, i_2;
  114.  
  115.     /* Builtin functions */
  116.     integer s_wsfe(), do_fio(), e_wsfe();
  117.  
  118.     /* Local variables */
  119.     static integer loce, loct;
  120.     extern /* Subroutine */ int move_();
  121.     static integer ipos, npos, i, j, itemp, jstop;
  122. #define nodplc ((integer *)&blank_1)
  123. #define cvalue ((complex *)&blank_1)
  124.     static doublereal asweep;
  125.     extern /* Subroutine */ int outnam_();
  126.  
  127.     /* Fortran I/O blocks */
  128.     static cilist io__15 = { 0, 0, 0, fmt_91, 0 };
  129.     static cilist io__16 = { 0, 0, 0, fmt_101, 0 };
  130.  
  131.  
  132. /*<       implicit double precision (a-h,o-z) >*/
  133.  
  134. /*     this routine formats the column headers for tabular listings of */
  135. /* output variables. */
  136.  
  137. /* spice version 2g.6  sccsid=tabinf 3/15/83 */
  138. /*<       common /tabinf/ ielmnt,isbckt,nsbckt,iunsat,nunsat,itemps,numtem, >*/
  139. /*<      1   isens,nsens,ifour,nfour,ifield,icode,idelim,icolum,insize, >*/
  140. /*<      2   junode,lsbkpt,numbkp,iorder,jmnode,iur,iuc,ilc,ilr,numoff,isr, >*/
  141. /*<      3   nmoffc,iseq,iseq1,neqn,nodevs,ndiag,iswap,iequa,macins,lvnim1, >*/
  142. /*<      4   lx0,lvn,lynl,lyu,lyl,lx1,lx2,lx3,lx4,lx5,lx6,lx7,ld0,ld1,ltd, >*/
  143. /*<      5   imynl,imvn,lcvn,nsnod,nsmat,nsval,icnod,icmat,icval, >*/
  144. /*<      6   loutpt,lpol,lzer,irswpf,irswpr,icswpf,icswpr,irpt,jcpt, >*/
  145. /*<      7   irowno,jcolno,nttbr,nttar,lvntmp >*/
  146. /* spice version 2g.6  sccsid=status 3/15/83 */
  147. /*<       common /status/ omega,time,delta,delold(7),ag(7),vt,xni,egfet, >*/
  148. /*<      1   xmu,sfactr,mode,modedc,icalc,initf,method,iord,maxord,noncon, >*/
  149. /*<      2   iterno,itemno,nosolv,modac,ipiv,ivmflg,ipostp,iscrch,iofile >*/
  150. /* spice version 2g.6  sccsid=miscel 3/15/83 */
  151. /*<       common /miscel/ atime,aprog(3),adate,atitle(10),defl,defw,defad, >*/
  152. /*<      1  defas,rstats(50),iwidth,lwidth,nopage >*/
  153. /* spice version 2g.6  sccsid=dc 3/15/83 */
  154. /*<       common /dc/ tcstar(2),tcstop(2),tcincr(2),icvflg,itcelm(2),kssop, >*/
  155. /*<      1   kinel,kidin,kovar,kidout >*/
  156. /* spice version 2g.6  sccsid=ac 3/15/83 */
  157. /*<       common /ac/ fstart,fstop,fincr,skw2,refprl,spw2,jacflg,idfreq, >*/
  158. /*<      1   inoise,nosprt,nosout,nosin,idist,idprt >*/
  159. /* spice version 2g.6  sccsid=tran 3/15/83 */
  160. /*<       common /tran/ tstep,tstop,tstart,delmax,tdmax,forfre,jtrflg >*/
  161. /* spice version 2g.6  sccsid=outinf 3/15/83 */
  162. /*<       common /outinf/ xincr,string(15),xstart,yvar(8),itab(8),itype(8), >*/
  163. /*<      1   ilogy(8),npoint,numout,kntr,numdgt >*/
  164. /* spice version 2g.6  sccsid=blank 3/15/83 */
  165. /*<       common /blank/ value(200000) >*/
  166. /*<       integer nodplc(64) >*/
  167. /*<       complex cvalue(32) >*/
  168. /*<       equivalence (value(1),nodplc(1),cvalue(1)) >*/
  169.  
  170. /*<       data ablnk, atimex, afreq / 1h , 6h  time, 6h  freq / >*/
  171.  
  172. /*  set limits depending upon the analysis mode */
  173.  
  174. /*<       if (mode-2) 10,20,30 >*/
  175.     if ((i_1 = status_1.mode - 2) < 0) {
  176.     goto L10;
  177.     } else if (i_1 == 0) {
  178.     goto L20;
  179.     } else {
  180.     goto L30;
  181.     }
  182. /*<    10 xstart=tcstar(1) >*/
  183. L10:
  184.     outinf_1.xstart = dc_1.tcstar[0];
  185. /*<       xincr=tcincr(1) >*/
  186.     outinf_1.xincr = dc_1.tcincr[0];
  187. /*<       npoint=icvflg >*/
  188.     outinf_1.npoint = dc_1.icvflg;
  189. /*<       itemp=itcelm(1) >*/
  190.     itemp = dc_1.itcelm[0];
  191. /*<       loce=nodplc(itemp+1) >*/
  192.     loce = nodplc[itemp];
  193. /*<       asweep=value(loce) >*/
  194.     asweep = blank_1.value[loce - 1];
  195. /*<       go to 40 >*/
  196.     goto L40;
  197. /*<    20 xstart=tstart >*/
  198. L20:
  199.     outinf_1.xstart = tran_1.tstart;
  200. /*<       xincr=tstep >*/
  201.     outinf_1.xincr = tran_1.tstep;
  202. /*<       npoint=jtrflg >*/
  203.     outinf_1.npoint = tran_1.jtrflg;
  204. /*<       asweep=atimex >*/
  205.     asweep = atimex;
  206. /*<       go to 40 >*/
  207.     goto L40;
  208. /*<    30 xstart=fstart >*/
  209. L30:
  210.     outinf_1.xstart = ac_1.fstart;
  211. /*<       xincr=fincr >*/
  212.     outinf_1.xincr = ac_1.fincr;
  213. /*<       npoint=icalc >*/
  214.     outinf_1.npoint = status_1.icalc;
  215. /*<       asweep=afreq >*/
  216.     asweep = afreq;
  217.  
  218. /*  construct and print the output variable names */
  219.  
  220. /*<    40 loct=loc+2 >*/
  221. L40:
  222.     loct = *loc + 2;
  223. /*<       ipos=1 >*/
  224.     ipos = 1;
  225. /*<       npos=ipos+numdgt+8 >*/
  226.     npos = ipos + outinf_1.numdgt + 8;
  227. /*<       do 90 i=1,kntr >*/
  228.     i_1 = outinf_1.kntr;
  229.     for (i = 1; i <= i_1; ++i) {
  230. /*<       loct=loct+2 >*/
  231.     loct += 2;
  232. /*<       itab(i)=nodplc(loct) >*/
  233.     outinf_1.itab[i - 1] = nodplc[loct - 1];
  234. /*<       itype(i)=nodplc(loct+1) >*/
  235.     outinf_1.itype[i - 1] = nodplc[loct];
  236. /*<       call outnam(itab(i),itype(i),string,ipos) >*/
  237.     outnam_(&outinf_1.itab[i - 1], &outinf_1.itype[i - 1], 
  238.         outinf_1.string, &ipos);
  239. /*<       if (ipos.ge.npos) go to 70 >*/
  240.     if (ipos >= npos) {
  241.         goto L70;
  242.     }
  243. /*<       do 60 j=ipos,npos >*/
  244.     i_2 = npos;
  245.     for (j = ipos; j <= i_2; ++j) {
  246. /*<       call move(string,j,ablnk,1,1) >*/
  247.         move_(outinf_1.string, &j, &ablnk, &c__1, &c__1);
  248. /*<    60 continue >*/
  249. /* L60: */
  250.     }
  251. /*<       ipos=npos >*/
  252.     ipos = npos;
  253. /*<       go to 80 >*/
  254.     goto L80;
  255. /*<    70 call move(string,ipos,ablnk,1,1) >*/
  256. L70:
  257.     move_(outinf_1.string, &ipos, &ablnk, &c__1, &c__1);
  258. /*<       ipos=ipos+1 >*/
  259.     ++ipos;
  260. /*<    80 npos=npos+numdgt+8 >*/
  261. L80:
  262.     npos = npos + outinf_1.numdgt + 8;
  263. /*<    90 continue >*/
  264. /* L90: */
  265.     }
  266. /*<       call move(string,ipos,ablnk,1,7) >*/
  267.     move_(outinf_1.string, &ipos, &ablnk, &c__1, &c__7);
  268. /*<       jstop=(ipos+6)/8 >*/
  269.     jstop = (ipos + 6) / 8;
  270. /*<       write (iofile,91) asweep,(string(j),j=1,jstop) >*/
  271.     io__15.ciunit = status_1.iofile;
  272.     s_wsfe(&io__15);
  273.     do_fio(&c__1, (char *)&asweep, (ftnlen)sizeof(doublereal));
  274.     i_1 = jstop;
  275.     for (j = 1; j <= i_1; ++j) {
  276.     do_fio(&c__1, (char *)&outinf_1.string[j - 1], (ftnlen)sizeof(
  277.         doublereal));
  278.     }
  279.     e_wsfe();
  280. /*<    91 format(/3x,a8,5x,14a8,a4) >*/
  281. /*<       write (iofile,101) >*/
  282.     io__16.ciunit = status_1.iofile;
  283.     s_wsfe(&io__16);
  284.     e_wsfe();
  285. /*<   101 format(1hx/1h ) >*/
  286. /*<       return >*/
  287.     return 0;
  288. /*<       end >*/
  289. } /* setprn_ */
  290.  
  291. #undef cvalue
  292. #undef nodplc
  293. #undef afreq
  294. #undef atimex
  295. #undef ablnk
  296.  
  297.  
  298.